Internet Info 1994 March

home *** CD-ROM | disk | FTP | other *** search

/ Internet Info 1994 March / Internet Info CD-ROM (Walnut Creek) (March 1994).iso / networking / terms / kermit / b / ts2ds.asm < prev next >

Wrap

Assembly Source File | 1988-08-16 | 19.8 KB | 251 lines

MACRO 00000010 &CSECT PLIANF &DSALEN 00000020 .********************************************************************* 00000030 .* THIS MACRO GENERATES PROLOGUE AND RETURN CODE FOR A 00000040 .* REENTRANT ASSEMBLER SUBROUTINE CALLED BY A PL/I ROUTINE. 00000050 .* 00000060 .* PARAMETERS: 00000070 .* &CSECT : CSECTNAME FOR THE ASSEMBLER SUBROUTINE. 00000080 .* &DSALEN : LENGTH OF THE DSA ADDRESSED BY REGISTER 13, 00000090 .* IN EXCESS OF 88, MUST BE A MULTIPLE OF 8. 00000100 .* 00000110 .* CONVENTIONS: 00000120 .* START LABEL FOR THE EXECUTABLE CODE MUST BE "START". 00000130 .* RETURN TO THE CALLLER: " B RETURN ". 00000140 .* NAME OF THE DSA DSECT: "PLIDSA" . 00000150 .* BASE REGISTER : REGISTER 3. 00000160 .********************************************************************* 00000170 LCLA &IND,&LEN 00000180 &IND SETA &SYSNDX 00000190 &LEN SETA K'&CSECT 00000200 &CSECT.1 CSECT 00000210 DC CL7' ' 00000220 ORG *-&LEN 00000230 DC C'&CSECT' 00000240 DC AL1(&LEN) 00000250 SPACE 3 00000260 R0 EQU 0 00000270 R1 EQU 1 00000280 R2 EQU 2 00000290 R3 EQU 3 BASE REG, POINTS TO ENTRY 00000300 R4 EQU 4 00000310 R5 EQU 5 00000320 R6 EQU 6 00000330 R7 EQU 7 00000340 R8 EQU 8 00000350 R9 EQU 9 00000360 R10 EQU 10 00000370 R11 EQU 11 00000380 R12 EQU 12 DO NOT ALTER REGISTER 12 00000390 R13 EQU 13 BASE FOR PLIDSA DSECT 00000400 R14 EQU 14 00000410 R15 EQU 15 00000420 SPACE 3 00000430 PLIDSA DSECT 00000440 PLIFLAGS DS H 00000450 PLIOFFS DS H 00000460 PLIHSA DS F 00000470 PLILSA DS F 00000480 PLIREG14 DS F 00000490 PLIREG15 DS F 00000500 PLIREG0 DS F 00000510 PLIREG1 DS F 00000520 PLIREG2 DS F 00000530 PLIREG3 DS F 00000540 PLIREG4 DS F 00000550 PLIREG5 DS F 00000560 PLIREG6 DS F 00000570 PLIREG7 DS F 00000580 PLIREG8 DS F 00000590 PLIREG9 DS F 00000600 PLIREG10 DS F 00000610 PLIREG11 DS F 00000620 PLIREG12 DS F 00000630 PLILWS DS A 00000640 PLINAB DS A 00000650 PLIPNAB DS A 00000660 PLIENABC DS F 00000670 EJECT 00000680 &CSECT.1 CSECT 00000690 ENTRY &CSECT 00000700 &CSECT DS 0H 00000710 STM R14,R12,12(R13) 00000720 LR R3,R15 R3 : BASE REGISTER 00000730 USING &CSECT,R3 00000740 USING PLIDSA,R13 00000750 LA R0,88+&DSALEN 00000760 L R1,PLINAB R1 : NEXT AVAILABLE BYTE 00000770 ALR R0,R1 00000780 CL R0,12(R12) ENOUGH STORAGE ? 00000790 BNH ENGH&IND 00000800 L R15,116(R12) NO, 00000810 BALR R14,R15 BRANCH TO PL/I OVERFLOW ROUTINE 00000820 ENGH&IND EQU * 00000830 ST R0,76(R1) RESET NAB 00000840 ST R0,80(R1) RESET PROLOGUE NAB 00000850 ST 13,4(R1) STORE BACK-CHAIN 00000860 MVC 72(4,R1),PLILWS COPY LWS ADDRESS 00000870 LR R13,R1 R13 : BASE OF PLIDSA DSECT 00000880 MVI PLIFLAGS,X'80' SET PL/I 00000890 MVI PLIFLAGS+1,X'00' FLAGS 00000900 MVI PLIENABC+2,X'91' INITIALIZE CURRENT 00000910 MVI PLIENABC+3,X'C0' ENABLE CELLS 00000920 L R1,PLIHSA GET BACK 00000930 L R1,24(R1) PARAMETER REGISTER 00000940 B START BRANCH TO USER'S CODE 00000950 SPACE 3 00000960 RETURN EQU * 00000970 LR R0,R13 00000980 L R13,PLIHSA 00000990 L R14,PLIREG14 00001000 LM R2,R12,PLIREG2 00001010 BALR R1,R14 00001020 EJECT 00001030 MEND 00001040 00001050 PLNK TITLE 'PL/I - LINK INTERFACE' 00001060 ********************************************************************** 00001070 * PL/I INTERFACE TO LINK SVC 00001080 * 00001090 * DECLARATION : 00001100 * DCL PLILINK ENTRY(CHAR(8),...) 00001200 * OPTIONS(ASM INTER RETCODE); 00001300 * 00001400 * USE : CALL PLILINK(EPNAME,PARMS); 00001500 * 00001600 * PARAMETERS : 00001700 * EPNAME : NAME OF ENTRY POINT. 00001800 * PARMS : PARAMETERS TO BE PASSED. 00001900 * 00002000 * RETURN CODE : PASSED FROM LINKED PROGRAM 00002100 * 00002200 * MACRO USED : PLIANF 00002300 ********************************************************************** 00002400 SPACE 3 00002500 PLILINK PLIANF DSALEN 00002600 START EQU * 00002700 L R4,0(R1) GET EPNAME 00002800 LA R1,4(R1) CUT FIRST PARAMETER 00002900 MVC LINKLIST(INITLEN),LISTINIT INITIALIZE WORKSTORAGE 00003000 LA R13,0(R13) CLEAR R13 (ERROR IN MVS XA SVC 6) WS 00003100 LINK LINK EPLOC=(4),MF=(E,(1)),SF=(E,LINKLIST) 00003200 B RETURN 00003300 SPACE 00003400 LISTINIT DS 0F 00003500 LINKINIT LINK EPLOC=*-*,SF=L 00003600 INITLEN EQU *-LISTINIT 00003700 SPACE 2 00003800 PLIDSA DSECT 00003900 LINKLIST LINK EPLOC=*-*,SF=L 00004000 DS 0D 00004100 DSALEN EQU *-LINKLIST 00004200 END 00004300 00004400 PSVC TITLE 'PL/I - SVC INTERFACE' 00004500 ********************************************************************** 00004600 * PL/I INTERFACE TO GENERAL SVC 00004700 * 00004800 * DECLARATION : 00004900 * DCL PLISVC ENTRY(BIN(15,0),BIN(31,0),BIN(31,0),BIN(31,0)); 00005000 * 00005100 * USE : CALL PLISVC(SVCNR,REG0,REG1,REG15); 00005200 * 00005300 * PARAMETERS : 00005400 * SVCNR : NUMBER OF SVC TO BE EXECUTED 00005500 * REG0,REG1,REG15 : VALUES TO BE LOADED INTO REGISTERS 00005600 * 0,1,15 RESPECTIVELY ON ENTRY TO SVC. 00005700 * THEY ARE RESTORED ON RETURN FROM SVC. 00005800 * 00005900 * MACRO USED : PLIANF 00006000 ********************************************************************** 00006100 SPACE 3 00006200 PLISVC PLIANF 0 00006300 START EQU * 00006400 LM R4,R7,0(R1) GET PARAMETERS 00006500 LH R8,0(R4) GET SVCNR 00006600 L R0,0(R5) LOAD REGISTER 0 VALUE 00006700 L R1,0(R6) LOAD REGISTER 1 VALUE 00006800 L R15,0(R7) LOAD REGISTER 15 VALUE 00006900 EX R8,SVC EXECUTE SVC 00007000 ST R0,0(R5) RESTORE REGISTER 0 VALUE 00007100 ST R1,0(R6) RESTORE REGISTER 1 VALUE 00007200 ST R15,0(R7) RESTORE REGISTER 15 VALUE 00007300 B RETURN RETURN 00007400 SPACE 2 00007500 SVC SVC 0 MODEL SVC INSTRUCTION 00007600 END 00007700 00007800 PTSR TITLE 'PL/I - INTERFACE TO TSO SERVICE ROUTINES' 00007900 ********************************************************************** 00008000 * PL/I INTERFACE TO TSO SERVICE ROUTINES 00008100 * 00008200 * DECLARATION : 00008300 * DCL PLITSSR ENTRY(CHAR(8),...) 00008400 * OPTIONS(ASM INTER RETCODE); 00008500 * 00008600 * USE : CALL PLITSSR(EPNAME,PARMS); 00008700 * 00008800 * PARAMETERS : 00008900 * EPNAME : NAME OF ENTRY POINT. 00009000 * PARMS : PARAMETERS TO BE PASSED. 00009100 * 00009200 * RETURN CODE : PASSED FROM TSO SERVICE ROUTINE 00009300 * 00009400 * MACRO USED : PLIANF 00009500 ********************************************************************** 00009600 SPACE 3 00009700 PLITSSR PLIANF DSALEN 00009800 START EQU * 00009900 L R4,0(R1) GET EPNAME 00010000 LA R1,4(R1) CUT FIRST PARAMETER 00010100 LA R5,TSSRTAB-LENENTRY 00010200 LA R6,LENENTRY 00010300 LA R7,TABEND-LENENTRY 00010400 TSSRLOOP BXH R5,R6,NOTFOUND 00010500 CLC 0(LENNAME,R3),0(R5) 00010600 BNE TSSRLOOP 00010700 FOUND EQU * 00010800 L R15,16 GET CVT ADDRESS 00010900 AL R15,(LENNAME)(R5) ADD OFFSET FROM LIST ENTRY 00011000 TM 0(R15),X'80' TEST IF ADDRESS VALID 00011100 BNO NOTFOUND NO, DO NORMAL LINK 00011200 L R15,0(R15) GET SERVICE ROUTINE ADDRESS 00011300 BALR R14,R15 OFF TO SERVICE ROUTINE 00011400 B RETURN 00011500 NOTFOUND EQU * 00011600 MVC LINKLIST(INITLEN),LISTINIT INITIALIZE WORKSTORAGE 00011700 LINK LINK EPLOC=(4),MF=(E,(1)),SF=(E,LINKLIST) 00011800 B RETURN 00011900 SPACE 00012000 LISTINIT DS 0F 00012100 LINKINIT LINK EPLOC=*-*,SF=L 00012200 INITLEN EQU *-LISTINIT 00012300 SPACE 2 00012400 * TABLE OF MVS TSO SERVICE ROUTINE ADDRESSES IN CVT 00012500 SPACE 00012600 * TO ACTIVATE TABLE FOR MVS, REMOVE STARS ON EACH ENTRY 00012700 * AND ON CVT DSECT=YES AND REASSEMBLE. 00012800 SPACE 00012900 TSSRTAB DS 0F 00013000 LENNAME EQU 8 00013100 LENENTRY EQU 12 00013200 GETL DC CL(LENNAME)'IKJGETL',A(CVTGETL-CVT) 00013300 PUTL DC CL(LENNAME)'IKJPUTL',A(CVTPUTL-CVT) 00013400 PTGT DC CL(LENNAME)'IKJPTGT',A(CVTPTGT-CVT) 00013500 STCK DC CL(LENNAME)'IKJSTCK',A(CVTSTCK-CVT) 00013600 SCAN DC CL(LENNAME)'IKJSCAN',A(CVTSCAN-CVT) 00013700 PARS DC CL(LENNAME)'IKJPARS',A(CVTPARS-CVT) 00013800 DAIR DC CL(LENNAME)'IKJDAIR',A(CVTDAIR-CVT) 00013900 EHDEF DC CL(LENNAME)'IKJEHDEF',A(CVTEHDEF-CVT) 00014000 EHCIR DC CL(LENNAME)'IKJEHCIR',A(CVTEHCIR-CVT) 00014100 EFF02 DC CL(LENNAME)'IKJEFF02',A(CVTEFF02-CVT) 00014200 TABEND EQU * 00014300 SPACE 2 00014400 CVT DSECT=YES 00014500 SPACE 3 00014600 PLIDSA DSECT 00014700 LINKLIST LINK EPLOC=*-*,SF=L 00014800 DS 0D 00014900 DSALEN EQU *-LINKLIST 00015000 END 00015100